home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 031-040 / amok35 / spellchecker / lexi.mod < prev    next >
Text File  |  1993-11-04  |  14KB  |  556 lines
  1. (*********************************************************************
  2.   :Program.    Lexi.mod
  3.   :Contents.   Basic funktions for Spellchecker
  4.   :Author.     Stefan Salewski
  5.   :Copyright.  PD
  6.   :Language.   Modula-2
  7.   :Translator. M2Amiga AMSoft V3.3d
  8.   :History.    V1.0 1.Mar.1990
  9.   :Address.    Stolper Weg 3, D-2160 Stade
  10.   :Imports.    TurboFilesV1.1, Assembler2V1.1 (my own)
  11.   :Imports.    MemSystem (Nicolas Benezan)
  12. *********************************************************************)
  13.  
  14. IMPLEMENTATION MODULE Lexi;
  15.   FROM Assembler2 IMPORT MaxCard,MinCard,MinInt,Equal;
  16.   FROM Arts IMPORT Assert,Error;
  17.   FROM Exec IMPORT UByte;
  18.   FROM SYSTEM IMPORT ADR,CAST;
  19.   FROM MemSystem IMPORT Allocate,Deallocate,MinMemory,Hysteresis;
  20.   IMPORT Str;
  21.   FROM Strings IMPORT Copy,Delete;
  22.   FROM TurboFiles IMPORT Lookup,CloseFile,TurboRead,TurboWrite,
  23.        TurboSetPos,SetPosMode,DeleteFile,
  24.        TurboGetPos,TurboResult,ReadOnly,NewFile,FilePtr;
  25.  
  26.   CONST
  27.     VeryLongWordLength=2*MaxWordLength;
  28.     LexID='Lexikon (c) 1990 by Stefan Salewski';
  29.     Save=TRUE;
  30.     Load=FALSE;
  31.     ESC= 33C;
  32.     CSI=233C;
  33.     EOL=CHAR(10);
  34.     TFRB= 1024; (* TurboFilesReadBuffer  *)
  35.     TFWB=10240; (* TurboFilesWriteBuffer *)
  36.  
  37.   TYPE
  38.     FileName=ARRAY[0..80] OF CHAR;
  39.     LexEntry=RECORD
  40.       word:Word;
  41.       count:UByte;
  42.     END;
  43.  
  44.   VAR
  45.     lexID:ARRAY[0..SIZE(LexID)] OF CHAR;
  46.     lexPtr:POINTER TO ARRAY [1..MAX(CARDINAL)] OF LexEntry;
  47.     wordsInLex:CARDINAL;
  48.     LexSize:CARDINAL; (* This is a pseudo-Constant, so I use upper Case *)
  49.  
  50.   PROCEDURE Letter(c:CHAR):BOOLEAN;
  51.   BEGIN
  52.     IF ((c>='a') AND (c<='z')) OR ((c>='A') AND (c<='Z')) OR (c="'") THEN
  53.       RETURN TRUE
  54.     ELSIF (c>=CHAR(192)) THEN
  55.       RETURN (c#CHAR(215)) AND (c#CHAR(247))
  56.     ELSE
  57.       RETURN FALSE
  58.     END
  59.   END Letter;
  60.  
  61.   PROCEDURE Cap(c:CHAR):CHAR;
  62.   BEGIN
  63.     IF ((c>='a') AND (c<='z')) OR ((c>=CHAR(224)) AND (c#CHAR(255)) AND
  64.                                    (c#CHAR(247))) THEN
  65.       RETURN CAST(CHAR,CAST(UByte,c)-32)
  66.     ELSE
  67.       RETURN c
  68.     END
  69.   END Cap;
  70.  
  71.   PROCEDURE IsCap(c:CHAR):BOOLEAN;
  72.   BEGIN
  73.     RETURN((c>='A') AND (c<='Z')) OR ((c>=CHAR(192)) AND (c<=CHAR(222)) AND
  74.                                    (c#CHAR(215)))
  75.   END IsCap;
  76.  
  77.   PROCEDURE AllocLex;
  78.     VAR
  79.       fileName:FileName;
  80.   BEGIN
  81.     fileName:=TmpLexName;
  82.     IF SaveLex(fileName) THEN
  83.       IF LoadLex(fileName) THEN
  84.         IF DeleteFile(fileName) THEN END
  85.       ELSE
  86.         Error(ADR('OutOfMem! Lexikon is saved as:'),
  87.               ADR(TmpLexName));
  88.       END;
  89.     ELSE
  90.       Error(ADR('To Insert more Words I need:'),
  91.             ADR(TmpLexName));
  92.     END;
  93.   END AllocLex;
  94.  
  95.   PROCEDURE InsertWord(VAR w:Word;pos:CARDINAL;count:UByte);
  96.     VAR
  97.       i:CARDINAL;
  98.   BEGIN
  99.     IF (pos=0) OR (Str.Length(w)<MinWordLength) THEN RETURN END;
  100.     IF wordsInLex=LexSize THEN
  101.       AllocLex
  102.     END;
  103.     FOR i:=wordsInLex TO pos BY -1 DO
  104.       lexPtr^[i+1]:=lexPtr^[i]
  105.     END;
  106.     lexPtr^[pos].count:=count;
  107.     lexPtr^[pos].word:=w;
  108.     INC(wordsInLex)
  109.   END InsertWord;
  110.  
  111.   PROCEDURE InitLex;
  112.   BEGIN
  113.     wordsInLex:=0;
  114.   END InitLex;
  115.  
  116.   PROCEDURE Init;
  117.   BEGIN
  118.     MinMemory:=1024*100;
  119.     Hysteresis:=1024*50;
  120.     Allocate(lexPtr,MinWords*SIZE(LexEntry));
  121.     Assert(lexPtr#NIL,ADR('Not enough Memory for Lexikon!'));
  122.     LexSize:=MinWords;
  123.     wordsInLex:=0;
  124.   END Init;
  125.  
  126.   PROCEDURE Del(pos:CARDINAL);
  127.     VAR
  128.       i:CARDINAL;
  129.   BEGIN
  130.     FOR i:=pos TO wordsInLex-1 DO
  131.       lexPtr^[i]:=lexPtr^[i+1];
  132.     END;
  133.     DEC(wordsInLex);
  134.   END Del;
  135.  
  136.   PROCEDURE WordsInLex():CARDINAL;
  137.   BEGIN
  138.     RETURN wordsInLex
  139.   END WordsInLex;
  140.  
  141.   PROCEDURE BinSearch(VAR s:Word;VAR pos:CARDINAL;inc:UByte):BOOLEAN;
  142.     VAR
  143.       l,m,r,i:CARDINAL;
  144.   BEGIN
  145.     l:=1;
  146.     r:=wordsInLex+1;
  147.     WHILE l<r DO
  148.       m:=(l+r) DIV 2;
  149.       i:=0;
  150.       WHILE (lexPtr^[m].word[i]=s[i]) AND (s[i]#0C) DO
  151.         INC(i)
  152.       END;
  153.       IF (lexPtr^[m].word[i]<s[i]) THEN
  154.         l:=m+1
  155.       ELSE
  156.         r:=m
  157.       END;
  158.     END;
  159.     pos:=r;
  160.     IF r<=wordsInLex THEN
  161.       i:=0;
  162.       WHILE (lexPtr^[r].word[i]=s[i]) AND (s[i]#0C) DO
  163.         INC(i)
  164.       END;
  165.       IF (s[i]>lexPtr^[r].word[i]) THEN
  166.         INC(pos);
  167.         RETURN FALSE
  168.       ELSIF (s[i]=lexPtr^[r].word[i]) THEN
  169.         IF lexPtr^[pos].count<=MAX(UByte)-inc THEN
  170.           INC(lexPtr^[pos].count,inc);
  171.         END;
  172.         RETURN TRUE
  173.       END;
  174.     END;
  175.     RETURN FALSE
  176.   END BinSearch;
  177.  
  178.   PROCEDURE DeleteWord(VAR w:Word):BOOLEAN;
  179.     VAR
  180.       pos,i:CARDINAL;
  181.   BEGIN
  182.     IF BinSearch(w,pos,0) THEN
  183.       Del(pos);
  184.       RETURN TRUE
  185.     ELSE
  186.       RETURN FALSE
  187.     END;
  188.   END DeleteWord;
  189.  
  190.   PROCEDURE SearchString(VAR w:ARRAY OF CHAR;VAR pos:CARDINAL;
  191.                              inc:UByte):BOOLEAN;
  192.     VAR
  193.       right,left:Word;
  194.       undoBuf:ARRAY[0..2*MaxWordLength] OF CHAR;
  195.       len,h,startLen:INTEGER;
  196.       p:CARDINAL;
  197.       up,bufferFree:BOOLEAN;
  198.   BEGIN
  199.     bufferFree:=TRUE;
  200.     startLen:=Str.Length(w);
  201.     len:=startLen;
  202.     up:=IsCap(w[0]);
  203.     h:=MinInt(len,MaxWordLength);
  204.     Copy(left,w,0,h);
  205.     Copy(right,w,len-h,h);
  206.     WHILE h>=MinFracSizeS DO
  207.       IF up THEN right[0]:=Cap(right[0]) END;
  208.       IF BinSearch(left,p,inc) THEN
  209.         DEC(len,h);
  210.         IF len=0 THEN RETURN TRUE END;
  211.         IF (len<MinFracSizeI) AND bufferFree THEN
  212.           Str.Copy(undoBuf,w);
  213.           bufferFree:=FALSE;
  214.         END;
  215.         Delete(w,0,h);
  216.         IF up THEN w[0]:=Cap(w[0]) END;
  217.         h:=MinInt(len,MaxWordLength);
  218.         Copy(left,w,0,h);
  219.         Copy(right,w,len-h,h);
  220.       ELSIF BinSearch(right,p,inc) THEN
  221.         DEC(len,h);
  222.         IF len=0 THEN RETURN TRUE END;
  223.         IF (len<MinFracSizeI) AND bufferFree THEN
  224.           Str.Copy(undoBuf,w);
  225.           bufferFree:=FALSE;
  226.         END;
  227.         w[len]:=0C;
  228.         h:=MinInt(len,MaxWordLength);
  229.         Copy(left,w,0,h);
  230.         Copy(right,w,len-h,h);
  231.       ELSE
  232.         DEC(h);
  233.         left[h]:=0C;
  234.         Delete(right,0,1);
  235.       END;
  236.     END;
  237.     (*IF len=0 THEN
  238.       RETURN TRUE
  239.     ELS*)IF len>MaxWordLength THEN
  240.       pos:=0;
  241.       RETURN FALSE
  242.     ELSIF (len>=MinFracSizeI) OR (len=startLen) THEN
  243.       Str.Copy(left,w);
  244.       RETURN BinSearch(left,pos,inc)
  245.     ELSE
  246.       IF NOT bufferFree AND (Str.Length(undoBuf)<=MaxWordLength) THEN
  247.         Str.Copy(w,undoBuf);
  248.         Str.Copy(left,undoBuf);
  249.         RETURN BinSearch(left,pos,inc)
  250.       ELSE
  251.         pos:=0;
  252.         RETURN FALSE
  253.       END;
  254.     END;
  255.   END SearchString;
  256.  
  257.   PROCEDURE ReadWord(source,echo:FilePtr;
  258.                      VAR str:ARRAY OF CHAR;VAR info:InfoSet;
  259.                      minLength,maxLength:CARDINAL);
  260.   VAR
  261.     actual,startPos:LONGINT;
  262.     get,strLength,pos:CARDINAL;
  263.     c:CHAR;
  264.   BEGIN
  265.     IF TurboGetPos(source)=0 THEN
  266.       info:=InfoSet{cap}
  267.     ELSE
  268.       info:=InfoSet{}
  269.     END;
  270.     strLength:=MinCard(HIGH(str),maxLength);
  271.     IF strLength=0 THEN str[0]:=0C; RETURN END;
  272.     REPEAT
  273.       LOOP
  274.       (* Ignore Control-Sequences... concept stolen from Muchmore V1.5 *)
  275.         TurboRead(source,ADR(c),1,actual);
  276.         IF echo#NIL THEN
  277.           TurboWrite(echo,ADR(c),actual)
  278.         END;
  279.         IF (c#ESC) AND (c#CSI) THEN EXIT END;
  280.         REPEAT
  281.           TurboRead(source,ADR(c),1,actual);
  282.           IF echo#NIL THEN
  283.             TurboWrite(echo,ADR(c),actual)
  284.           END;
  285.           c:=CAP(c);
  286.         UNTIL ((c>="?") AND (c<="Z")) OR (source^.res#done);
  287.       END;
  288.       IF (c='.') OR (c='?') OR (c='!') OR (c=':') THEN
  289.         INCL(info,cap)
  290.       END;
  291.     UNTIL Letter(c) OR (source^.res#done);
  292.     str[0]:=c;
  293.     startPos:=TurboGetPos(source);
  294.     pos:=0;
  295.     WHILE Letter(str[pos]) AND (source^.res=done) DO
  296.       IF pos<strLength THEN
  297.         INC(pos)
  298.       END;
  299.       TurboRead(source,ADR(str[pos]),1,actual);
  300.       IF echo#NIL THEN
  301.         TurboWrite(echo,ADR(str[pos]),actual)
  302.       END;
  303.     END;
  304.     IF (str[pos]='-') THEN
  305.       INCL(info,hyphen)
  306.     ELSIF (str[pos]=CHAR(4)) THEN
  307.       INCL(info,bHyphen)
  308.     END;
  309.     get:=TurboGetPos(source)-startPos;
  310.     IF TurboSetPos(source,-1,current) THEN END;
  311.     IF (echo#NIL) AND TurboSetPos(echo,-1,current) THEN END;
  312.     IF (actual#0) AND (get<=strLength) AND (get>=minLength) THEN
  313.       str[pos]:=0C;
  314.     ELSE
  315.       str[0]:=0C
  316.     END;
  317.   END ReadWord;
  318.  
  319.   PROCEDURE ExpandLex(VAR textName:ARRAY OF CHAR):BOOLEAN;
  320.     VAR
  321.       info:InfoSet;
  322.       runs:CARDINAL;
  323.       fPtr:FilePtr;
  324.       cap:BOOLEAN;
  325.       w:ARRAY[0..VeryLongWordLength] OF CHAR;
  326.       word:Word;
  327.       count:UByte;
  328.       pos:CARDINAL;
  329.       nil:ARRAY[0..4] OF CHAR;
  330.   BEGIN
  331.     nil:='NIL:';
  332.     IF Lookup(fPtr,textName,TFRB,ReadOnly)=done THEN
  333.       runs:=MinCard(MinFracSizeI,MinFracSizeS)-1;
  334.       count:=0;
  335.       REPEAT
  336.         IF runs>=MaxWordLength THEN
  337.           runs:=VeryLongWordLength;
  338.           count:=1
  339.         ELSE
  340.           INC(runs,MinFracSizeS)
  341.         END;
  342.         IF fPtr^.res=endOfFile THEN fPtr^.res:=done END;
  343.         IF TurboSetPos(fPtr,0,beginning) THEN END;
  344.         REPEAT
  345.           ReadWord(fPtr,NIL,w,info,MinWordLength,runs);
  346.           IF hyphen IN info THEN
  347.             ReadWord(fPtr,NIL,w,info,MinWordLength,runs);
  348.             ReadWord(fPtr,NIL,w,info,MinWordLength,runs);
  349.           ELSIF bHyphen IN info THEN
  350.             ReadWord(fPtr,NIL,w,info,MinWordLength,runs);
  351.             ReadWord(fPtr,NIL,w,info,MinWordLength,runs);
  352.             ReadWord(fPtr,NIL,w,info,MinWordLength,runs);
  353.           END;
  354.           IF (info=InfoSet{}) AND (w[0]#0C) AND NOT IsCap(w[1]) THEN
  355.             IF NOT SearchString(w,pos,count) AND (pos#0) THEN
  356.               Str.Copy(word,w);
  357.               InsertWord(word,pos,count);
  358.             END;
  359.           END;
  360.         UNTIL fPtr^.res#done;
  361.       UNTIL runs=VeryLongWordLength;
  362.       CloseFile(fPtr);
  363.       IF MinCount()=0 THEN
  364.         count:=CleanLex(nil)
  365.       END;
  366.       RETURN TRUE
  367.     ELSE
  368.       RETURN FALSE
  369.     END;
  370.   END ExpandLex;
  371.  
  372.   PROCEDURE SaveLex(VAR lexName:ARRAY OF CHAR):BOOLEAN;
  373.     VAR
  374.       i,entries:CARDINAL;
  375.       fPtr:FilePtr;
  376.       res:TurboResult;
  377.   BEGIN
  378.     entries:=wordsInLex;
  379.     IF Lookup(fPtr,lexName,TFWB,NewFile)=done THEN
  380.       TurboWrite(fPtr,ADR(LexID),SIZE(LexID));
  381.       TurboWrite(fPtr,ADR(entries),SIZE(entries));
  382.       FOR i:=1 TO entries DO
  383.         TurboWrite(fPtr,ADR(lexPtr^[i].word),Str.Length(lexPtr^[i].word)+1);
  384.         TurboWrite(fPtr,ADR(lexPtr^[i].count),SIZE(lexPtr^[i].count));
  385.       END;
  386.       res:=fPtr^.res;
  387.       CloseFile(fPtr);
  388.       RETURN res=done
  389.     ELSE
  390.       RETURN FALSE
  391.     END;
  392.   END SaveLex;
  393.  
  394.   PROCEDURE LoadLex(VAR lexName:ARRAY OF CHAR):BOOLEAN;
  395.     VAR
  396.       fPtr:FilePtr;
  397.       i,entries:CARDINAL;
  398.       j:INTEGER;
  399.       actual:LONGINT;
  400.       ok:BOOLEAN;
  401.   BEGIN
  402.     IF Lookup(fPtr,lexName,TFRB,ReadOnly)=done THEN
  403.       TurboRead(fPtr,ADR(lexID),SIZE(LexID),actual);
  404.       ok:=Equal(ADR(lexID),ADR(LexID),SIZE(LexID));
  405.       IF ok THEN
  406.         TurboRead(fPtr,ADR(entries),SIZE(entries),actual);
  407.         IF entries+MoreWords>LexSize THEN
  408.           Deallocate(lexPtr);
  409.           Allocate(lexPtr,LONGINT(entries+MoreWords)*SIZE(LexEntry));
  410.           Assert(lexPtr#NIL,ADR('Not enough Memory for Lexikon'));
  411.           LexSize:=entries+MoreWords
  412.         END;
  413.         i:=1;
  414.         WHILE (fPtr^.res=done) AND (i<=entries) DO
  415.           j:=-1;
  416.           REPEAT
  417.             INC(j);
  418.             TurboRead(fPtr,ADR(lexPtr^[i].word[j]),1,actual);
  419.           UNTIL (lexPtr^[i].word[j]=0C) OR (j=MaxWordLength);
  420.           TurboRead(fPtr,ADR(lexPtr^[i].count),SIZE(lexPtr^[i].count),actual);
  421.           INC(i);
  422.         END;
  423.         IF fPtr^.res=done THEN
  424.           wordsInLex:=entries;
  425.         ELSE
  426.           wordsInLex:=0;
  427.           ok:=FALSE
  428.         END;
  429.       END;
  430.       CloseFile(fPtr);
  431.       RETURN ok
  432.     ELSE
  433.       RETURN FALSE
  434.     END;
  435.   END LoadLex;
  436.  
  437.   PROCEDURE MinCount():UByte;
  438.     VAR
  439.       i:CARDINAL;
  440.       min:UByte;
  441.   BEGIN
  442.     min:=MAX(UByte);
  443.     FOR i:=1 TO wordsInLex DO
  444.       IF lexPtr^[i].count<min THEN
  445.         min:=lexPtr^[i].count
  446.       END;
  447.     END;
  448.     IF wordsInLex=0 THEN
  449.       RETURN 0
  450.     ELSE
  451.       RETURN min
  452.     END;
  453.   END MinCount;
  454.  
  455.   PROCEDURE MaxCount():UByte;
  456.     VAR
  457.       i:CARDINAL;
  458.       max:UByte;
  459.   BEGIN
  460.     max:=0;
  461.     FOR i:=1 TO wordsInLex DO
  462.       IF lexPtr^[i].count>max THEN
  463.         max:=lexPtr^[i].count
  464.       END;
  465.     END;
  466.     RETURN max
  467.   END MaxCount;
  468.  
  469.   (*PROCEDURE CleanLex(VAR cleanName:ARRAY OF CHAR):UByte;
  470.     VAR
  471.       fPtr:FilePtr;
  472.       i:CARDINAL;
  473.       min:UByte;
  474.       eol:CHAR;
  475.   BEGIN
  476.     eol:=EOL;
  477.     min:=MinCount();
  478.     IF Lookup(fPtr,cleanName,TFWB,NewFile)=done THEN
  479.       i:=1;
  480.       WHILE i<=wordsInLex DO
  481.         IF lexPtr^[i].count=min THEN
  482.           TurboWrite(fPtr,ADR(lexPtr^[i].word),Str.Length(lexPtr^[i].word));
  483.           TurboWrite(fPtr,ADR(eol),1);
  484.           Del(i);
  485.         ELSE
  486.           INC(i);
  487.         END;
  488.       END;
  489.       CloseFile(fPtr);
  490.       RETURN min
  491.     ELSE
  492.       RETURN 0
  493.     END;
  494.   END CleanLex;*)
  495.  
  496.   PROCEDURE CleanLex(VAR cleanName:ARRAY OF CHAR):UByte;
  497.     VAR
  498.       fPtr:FilePtr;
  499.       source,dest:CARDINAL;
  500.       min:UByte;
  501.       eol:CHAR;
  502.   BEGIN
  503.     eol:=EOL;
  504.     min:=MinCount();
  505.     IF Lookup(fPtr,cleanName,TFWB,NewFile)=done THEN
  506.       source:=1;
  507.       dest:=1;
  508.       LOOP
  509.         WHILE (source<=wordsInLex) AND (lexPtr^[source].count=min) DO
  510.           TurboWrite(fPtr,ADR(lexPtr^[source].word),
  511.                      Str.Length(lexPtr^[source].word));
  512.           TurboWrite(fPtr,ADR(eol),1);
  513.           INC(source);
  514.         END;
  515.         IF source<=wordsInLex THEN
  516.           lexPtr^[dest]:=lexPtr^[source];
  517.           INC(dest);
  518.           INC(source);
  519.         ELSE
  520.           EXIT
  521.         END;
  522.       END;
  523.       wordsInLex:=dest-1;
  524.       CloseFile(fPtr);
  525.       RETURN min
  526.     ELSE
  527.       RETURN 0
  528.     END;
  529.   END CleanLex;
  530.  
  531.   PROCEDURE ExportLex(VAR exportName:ARRAY OF CHAR):BOOLEAN;
  532.     VAR
  533.       fPtr:FilePtr;
  534.       i:CARDINAL;
  535.       res:TurboResult;
  536.       eol:CHAR;
  537.   BEGIN
  538.     eol:=EOL;
  539.     IF Lookup(fPtr,exportName,TFWB,NewFile)=done THEN
  540.       FOR i:=1 TO wordsInLex DO
  541.         TurboWrite(fPtr,ADR(lexPtr^[i].word),Str.Length(lexPtr^[i].word));
  542.         TurboWrite(fPtr,ADR(eol),1);
  543.       END;
  544.       res:=fPtr^.res;
  545.       CloseFile(fPtr);
  546.       RETURN res=done
  547.     ELSE
  548.       RETURN FALSE
  549.     END;
  550.   END ExportLex;
  551.  
  552. BEGIN
  553.   Init;
  554. END Lexi.
  555.  
  556.